perm filename PCODE.SAI[PNT,HE]8 blob sn#516906 filedate 1980-06-16 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00011 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00003 00003	! $pcd1,$pcd11,$pcda1
C00004 00004	! cmon codes:	frcpcode,durcpcode,expcpcode,evcpcode,cmonpcode,fcmonpcode
C00008 00005	! pdp10 routines: $afxpcode,$coordpcode
C00010 00006	! printing: prpcode,prvpcode
C00011 00007	! motion:$centerpcode,$movepcode,$drivepcode
C00015 00008	! control pcodes: if,for,while,do,case
C00020 00009	! cobegpcode
C00022 00010	! arrdclpcode,prcdclpcode,rtnpcode,smpdclpcode
C00026 00011	! load,dump pcodes
C00030 ENDMK
C⊗;
ENTRY;
BEGIN "PCODE"
COMMENT Module which produces the pcode interpretation of the
	relevant instructions ;

DEFINE $$PRGID=TRUE;	DEFINE $PCODE=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;
! $pcd1,$pcd11,$pcda1;

INTERNAL RPTR(EXPR$) PROCEDURE $PCD1(INTEGER I);
	RETURN(EXPR$1(PCDCOD[I]));

INTERNAL RPTR(EXPR$) PROCEDURE $PCD11(INTEGER I,J);
	RETURN(EXPR$2(PCDCOD[I],J));

INTERNAL RPTR(EXPR$) PROCEDURE $PCDA1(RPTR(EXPR$)E; INTEGER I);
	RETURN($APPEND(E,EXPR$1(PCDCOD[I])));

INTERNAL RPTR(EXPR$) PROCEDURE $PCDEE1(RPTR(EXPR$)E1,E2; INTEGER I);
	BEGIN
	RPTR(EXPR$)ARRAY E[1:3];
	E[1]←E1;
	E[2]←E2;
	E[3]←EXPR$1(PCDCOD[I]);
	RETURN($AAPPEND(E));
	END;
! cmon codes:	frcpcode,durcpcode,expcpcode,evcpcode,cmonpcode,fcmonpcode;

RPTR(EXPR$)PROCEDURE FRCDURPCODE(RPTR(EXPR$)EXP,ACTION,MONITOR);
	BEGIN
	RPTR(EXPR$)ARRAY F[1:4];
	F[1]←EXP;
	F[2]←MONITOR;
	F[3]←ACTION;
	F[4]←EXPR$1(XCMDONE);
	RETURN($AAPPEND(F));
	END;

INTERNAL RPTR(EXPR$) PROCEDURE $FRCPCODE(RPTR(EXPR$)EXP,ACTION,CFRAME);
	RETURN(FRCDURPCODE(EXP,ACTION,$APPEND(CFRAME,EXPR$1(XPCMFORCE))));

INTERNAL RPTR(EXPR$) PROCEDURE $DURCPCODE(RPTR(EXPR$)EXP,ACTION);
	RETURN(FRCDURPCODE(EXP,ACTION,EXPR$1(XCMDUR)));

INTERNAL RPTR(EXPR$)PROCEDURE $EXPCPCODE(RPTR(EXPR$)EXP,ACTION);
	BEGIN
	RPTR(EXPR$)ARRAY F[1:5];
	F[1]←EXPR$2(XCMSKED,100);
	F[2]←EXP;
	F[3]←EXPR$2(XRJMPC);
	F[4]←ACTION;
	F[5]←EXPR$2(XRJMP);
	EXPR$:BODY[F[3]][2]←-EXPR$OFF(F,1,2);
	EXPR$:BODY[F[5]][2]←-EXPR$OFF(F,1,4);
	RETURN($AAPPEND(F));
	END;

INTERNAL RPTR(EXPR$)PROCEDURE $EVCPCODE(RPTR(EXPR$)EXP,ACTION);
	BEGIN
	RPTR(EXPR$)ARRAY F[1:5];
	F[1]←EXPR$1(XCMSKED);
	F[2]←EXP;
	F[3]←EXPR$2(XPCMWAIT,XCMTRIG);
	F[4]←ACTION;
	F[5]←EXPR$2(XRJMP);
	EXPR$:BODY[F[5]][2]←-EXPR$OFF(F,1,4);
	RETURN($AAPPEND(F));
	END;

INTERNAL RPTR(EXPR$)PROCEDURE $CMONPCODE(RPTR(EXPR$)E; INTEGER CMTYPE,FBITS(0),#ENV(6));
	BEGIN
	DEFINE IPC=-1;	! act as marker;
	RPTR(EXPR$) ARRAY F[1:3];  INTEGER I;
	F[1]←EXPR$2(XGTBLK,EXPR$:#BODY[E]);
	F[2]←E;
	FOR I←5,XMVAR,#CMNTYP,1,CMTYPE,IPC,#ENV DO IPUSH(I);
		IF CMTYPE=#CMFRC THEN IPUSH(FBITS);
		IPUSH(0);
	F[3]←βEXPR$;
	RETURN($AAPPEND(F));
	END;

INTERNAL RPTR(EXPR$)PROCEDURE $ONPCODE(RPTR(EXPR$)E; INTEGER OFF,CMTYPE,FBITS(0),#ENV(6));
	BEGIN
	DEFINE IPC=-1;	! act as marker;
	RPTR(EXPR$) ARRAY F[1:3];  INTEGER I;
	F[1]←EXPR$2(XGTBLK,EXPR$:#BODY[E]);
	F[2]←E;
	FOR I←4,XCMFIL,OFF,CMTYPE,IPC,#ENV DO IPUSH(I);
		IF CMTYPE=#CMFRC THEN IPUSH(FBITS);
	F[3]←βEXPR$;
	RETURN($AAPPEND(F));
	END;
! pdp10 routines: $afxpcode,$coordpcode;

INTERNAL RPTR(EXPR$) PROCEDURE $AFXPCODE(RPTR(EXPR$)SON,DAD; INTEGER AFFTYPE;
	RPTR(EXPR$)E1);
	BEGIN
	INTEGER AFFCODE;
	RPTR(EXPR$)EE; RPTR(EXPR$) ARRAY E[1:4];
	AFFCODE←IF AFFTYPE≠#RGDLK THEN #NONRGD ELSE 0;
	IF E1 THEN E[1]←E1
		ELSE BEGIN E[1]←EXPR$1(XNOOP);AFFCODE←AFFCODE+'100000; END;
	    E[2]←DAD;
	    E[3]←SON;
	    E[4]←EXPR$2(XPAFFIX,AFFCODE);
	    EE←$AAPPEND(E);
	RETURN(EE);
	END;

INTERNAL RPTR(EXPR$) PROCEDURE $COORDPCODE(RPTR(EXPR$)E1,E2; INTEGER ELEMENT,TYPE);
	BEGIN
	RPTR(EXPR$)ARRAY PTR[1:3];
	PTR[1]←E2;	! compute the value;
	PTR[2]←E1;	! put reference of id on the interpreter stack;
	CASE TYPE OF
		BEGIN
		[#SC]	PTR[3]←EXPR$2(XCHCMP,ELEMENT);
		[#VT]	PTR[3]←EXPR$1(XCHTPOS);
		[#RT]	PTR[3]←EXPR$1(XCHTORIENT)
		END;
	RETURN($AAPPEND(PTR));
	END;
! printing: prpcode,prvpcode;

INTERNAL RPTR(EXPR$) PROCEDURE $PRVPCODE(RPTR(EXPR$)E);
	BEGIN RPTR(EXPR$) P;
	! uses AL printing format or POINTY format depending on value of !ALPRIN;
	IF !ALPRIN THEN P←EXPR$1(XVALPRN) ELSE P←EXPR$2(XPRVAL,EXPR$:TYPE[E]);
	RETURN($APPEND(E,P,EXPR$:TYPE[E]));
	END;

INTERNAL RPTR(EXPR$)PROCEDURE $PRPCODE(STRING S);
IF LENGTH(S)=1 THEN RETURN(EXPR$2(XPRNTC,LOP(S)))
	ELSE
	BEGIN
	INTEGER I;
	IPUSH(XPRNTI);		! push string immediate pcode ;
	IPUSH((LENGTH(S)+2)DIV 2);	! push number of words ;
	DO IPUSH(LOP(S)+ (I←LOP(S)) LSH 8) UNTIL I=0;
	RETURN(βEXPR$);
	END;
! motion:$centerpcode,$movepcode,$drivepcode;

PRELOAD_WITH '100000,'40000,'20000,'10000,'4000,'2000,'1000,
			'400,'200,'100,'40,'20,'10,'4;
INTEGER ARRAY JT_CODE[0:1,1:7];

ifc false thenc
INTERNAL RPTR(EXPR$)PROCEDURE $DRIVEPCODE(INTEGER COLOR;STRING HOW;
	INTEGER JOINT;RPTR(EXPR$)SCAL);
	BEGIN RPTR(EXPR$)E;
	    INTEGER I;
		    FOR I←XCHNGE,$TSCOFF,XRJMP,9,
			JT_CODE[COLOR,JOINT],0,0,0, $TSCOFF,0,0,0,
			(IF EQU(HOW,"BY") THEN XRTDDRIVE ELSE XRTADRIVE),
			-9,
			(IF 1≤JOINT≤6
				THEN IF COLOR=BLUE THEN BARM_MECH
				ELSE YARM_MECH
				ELSE IF COLOR=BLUE THEN BHAND_MECH
				ELSE YHAND_MECH),0,5,-1
			DO IPUSH(I);		! extra zeroes as in movepcode;
	    E←$APPEND(SCAL,βEXPR$);
	    RETURN(E);
	END;
INTERNAL PROCEDURE $MOVEPCODE(RPTR(SYMBOL)S1,S2;
		RPTR(EXPR$)ARRAY FDESTS; INTEGER NFDEST;
		REFERENCE RPTR(EXPR$) DESTCOMP,MOVCODE);
	BEGIN
	RPTR(EXPR$) ARRAY BDESTS[0:NFDEST],PTR[1:3];
	RPTR(EXPR$) PPTR;
	INTEGER I,J,INDEX;
		J←$TTROFF;
		GPUSH(S1);
		IPUSH(XTINVRT);
		GPUSH(S2);
		FOR I←	XTTMUL,
			XCHNGE, J
			DO IPUSH(I);
		BDESTS[0]←βEXPR$;
		FOR I←1 STEP 1 UNTIL NFDEST
		DO BEGIN INTEGER I1;
			FOR I1←XGTVAL,J,XTTMUL, XCHNGE,J+I DO IPUSH(I1);
			BDESTS[I]←$APPEND(FDESTS[I],βEXPR$,0);
		   END;
	DESTCOMP←$AAPPEND(BDESTS);
	PTR[1]←EXPR$2(XRJMP);
		FOR I←BARMSB,0,0,0,0 DO IPUSH(I);	! servo bits, servo bits,
						motion bits, wobble addr,
						duration or speed factor;
		FOR I←1 STEP 1 UNTIL NFDEST DO
			BEGIN
			IPUSH(J+I); IPUSH(0);IPUSH(0)
			END;
		IPUSH(0);
	PTR[2]←βEXPR$;
	EXPR$:BODY[PTR[1]][2]←EXPR$OFF(PTR,2,2);
		FOR I←XRPMOVE, - (EXPR$:#BODY[PTR[2]]+1),
			BARM_MECH,0,5,-1
		DO IPUSH(I);	! last three integers for error bits,
						addrs next pcode,
						retry addrs(to be inserted later);
	PTR[3]←βEXPR$;
	MOVCODE←$AAPPEND(PTR);
	END;

INTERNAL RPTR(EXPR$) PROCEDURE $CENTERPCODE(INTEGER ARM);
BEGIN "CENTER"
	INTEGER I;
	RPTR(EXPR$) PTR;
	    FOR I←XRJMP,9,
		(IF ARM=BLUE THEN (BARMSB+BHANDSB) ELSE (YHANDSB+YARMSB)),
		0,0,0,0,0,0,0,
		XRCENTER,- 9,
		(IF ARM=BLUE THEN BARM_MECH+BHAND_MECH ELSE YARM_MECH+YHAND_MECH),
		0,5,-1
	    DO	IPUSH(I);	! last three integers as for movepcode;
	PTR←βEXPR$;
	RETURN(PTR);
END "CENTER";

endc
! control pcodes: if,for,while,do,case;
INTERNAL RPTR(EXPR$)PROCEDURE $IFPCODE(RPTR(EXPR$) COND,A,B(NULL));
BEGIN
	RPTR(EXPR$)ARRAY IFP[1:5];
	IFP[1]←COND;
	IFP[2]←EXPR$2(XRJMPC);
	IFP[3]←A;
	IFP[4]←EXPR$2(XRJMP);
	IFP[5]←IF B THEN B ELSE EXPR$1(XNOOP);
	EXPR$:BODY[IFP[2]][2]←EXPR$OFF(IFP,3,4);
	EXPR$:BODY[IFP[4]][2]←EXPR$OFF(IFP,5,5);
	RETURN($AAPPEND(IFP));
END;

INTERNAL RPTR(EXPR$)PROCEDURE $WHILEPCODE(RPTR(EXPR$)COND,STAT);
BEGIN
	RPTR(EXPR$)ARRAY WHP[1:4];
	WHP[1]←COND;
	WHP[2]←EXPR$2(XRJMPC);
	WHP[3]←STAT;
	WHP[4]←EXPR$2(XRJMP);
	EXPR$:BODY[WHP[2]][2]←EXPR$OFF(WHP,3,4);
	EXPR$:BODY[WHP[4]][2]←-EXPR$OFF(WHP,1,3);
	RETURN($AAPPEND(WHP));
END;

INTERNAL RPTR(EXPR$)PROCEDURE $DOPCODE(RPTR(EXPR$)S,B);
	BEGIN
	RPTR(EXPR$)ARRAY DOP[1:3];
	DOP[1]←S;
	DOP[2]←B;
	DOP[3]←EXPR$2(XRJMPC,-EXPR$OFF(DOP,1,2));
	RETURN($AAPPEND(DOP));
	END;

INTERNAL RPTR(EXPR$)PROCEDURE $FORPCODE(RPTR(EXPR$)I0,I1,I2,I3,S);
	BEGIN
	RPTR(EXPR$) ARRAY FORP[1:7];
	FORP[1]←I1;
	FORP[2]←I3;
	FORP[3]←I2;
	FORP[4]←I0;
	FORP[5]←EXPR$2(XRFRCHK);
	FORP[6]←S;
	FORP[7]←EXPR$2(XRFOREND);
	EXPR$:BODY[FORP[7]][2]←-EXPR$OFF(FORP,4,6);
	EXPR$:BODY[FORP[5]][2]←EXPR$OFF(FORP,6,7);
	RETURN($AAPPEND(FORP));
	END;

INTERNAL RPTR(EXPR$)PROCEDURE $CASEPCODE(RPTR(EXPR$) EXI;RPTR(CASE$) EXC;
		BOOLEAN READELSE;INTEGER MAXNUM);
	BEGIN
 	RPTR(EXPR$) ARRAY EX1[1: 2*(MAXNUM+1)+6]; ! ????;
	INTEGER ARRAY BUFFLAB[1: MAXNUM+2];
	RPTR(CASE$)TEMP; 
	INTEGER OFFSET,I,CASEADDR,J,TEMPLAB;
	EX1[1]←EXI;		! index;
	IF READELSE THEN EX1[2]←EXPR$2(XRCASE, -(MAXNUM+1))
		    ELSE EX1[2]←EXPR$2(XRCASE, MAXNUM+1);		! XCASE and range;
! generate label list in bufflab and expressions;
	TEMP←EXC;
! initial offset: max+2 (=labels) + 2 (rjmp,exit label);
	OFFSET←MAXNUM+4;  		
	I←5;
	DO BEGIN
	   IF (CASEADDR←CASE$:NUM[TEMP])=#ELSE
		THEN CASEADDR←MAXNUM+1;
	   BUFFLAB[CASEADDR+1]←OFFSET;		! computes labels;
	   OFFSET←OFFSET+EXPR$:#BODY[CASE$:BODY[TEMP]]+2;
	   EX1[I]←CASE$:BODY[TEMP];		! statement;
	   EX1[I+1]←EXPR$2(XRJMP,-OFFSET+ MAXNUM+3);	! xrjmp + label;
	   I←I+2;
	   TEMP←CASE$:NEXT[TEMP];		! next records;
	   WHILE  TEMP≠NULL!RECORD AND
		  CASE$:BODY[TEMP]=NULL!RECORD DO
		   BEGIN
		   BUFFLAB[(IF CASE$:NUM[TEMP]=#ELSE THEN MAXNUM+1
			      ELSE CASE$:NUM[TEMP]) + 1]
				←BUFFLAB[CASEADDR+1];	! computes labels;
		   TEMP←CASE$:NEXT[TEMP];		! next records;
		   END;
	   END
	UNTIL TEMP=NULL!RECORD ;
	! fill up the label list;
	TEMPLAB←IF READELSE THEN BUFFLAB[MAXNUM+2] ELSE OFFSET;
	FOR J←1 STEP 1 UNTIL MAXNUM+2
		DO IF BUFFLAB[J]=0 THEN BUFFLAB[J]←TEMPLAB;
! bufflab[1: i];
	EX1[3]←αEXPR$(BUFFLAB);
	EX1[4]←EXPR$2(XRJMP,OFFSET-(MAXNUM+3));		! jump exit;
	RETURN($AAPPEND(EX1));
	END;
! cobegpcode;
INTERNAL RPTR(EXPR$)PROCEDURE $COBEGPCODE(RPTR(EXPR$)ARRAY STATEMENTS);
BEGIN	! outputting the following:

	0$:   RJMP $X-0$-1
	1$:   STATEMENT 1
	      TERMINATE
	2$:   STATEMENT 2
	      TERMINATE
	...
	N$:   STATEMENT N
	      TERMINATE
	$X:   XSPROUT 
	$X+1: N (i.e. # of statements)
	$Y:   1$-$Y
	      0
	      2$-$Y
	      0
	      ..
	      N$-$Y
	      0
	      0
	;
	RPTR(EXPR$) ARRAY PTR[0:ARRINFO(STATEMENTS,2)+1];
	RPTR(EXPR$) E; INTEGER #ENV;
	INTEGER #ARRSIZE,I;
	#ENV←20;
	#ARRSIZE←ARRINFO(STATEMENTS,2);
	FOR I←1 STEP 1 UNTIL #ARRSIZE
		DO PTR[I]←$APPEND(STATEMENTS[I],EXPR$1(XTERMINATE));
	E←PTR[#ARRSIZE+1]←NEXPR(#ARRSIZE*2+3,XPSPROUT);
	EXPR$:BODY[E][2]←#ARRSIZE;
	FOR I←1 STEP 1 UNTIL #ARRSIZE
		DO BEGIN EXPR$:BODY[E][2*I+1]←-EXPR$OFF(PTR,I,#ARRSIZE)-1;
			EXPR$:BODY[E][2*I+2]←#ENV; END;
	PTR[0]←EXPR$2(XRJMP,EXPR$OFF(PTR,1,#ARRSIZE));
	RETURN($AAPPEND(PTR));
END;
! arrdclpcode,prcdclpcode,rtnpcode,smpdclpcode;

INTERNAL RPTR(EXPR$)PROCEDURE $SMPDCLPCODE(INTEGER OBTYPE,J);
	BEGIN
	INTEGER I;
	FOR I←XMVAR, OBTYPES[OBTYPE], J, 0 DO IPUSH(I);
	RETURN(βEXPR$(OBTYPE));
	END;

RPTR(EXPR$)PROCEDURE $KVARPCODE(INTEGER N);
	IF N>0 THEN RETURN(EXPR$2(XKVAR,N)) ELSE RETURN(EXPR$1(XNOOP));

INTERNAL RPTR(EXPR$)PROCEDURE $RTNPCODE(RPTR(EXPR$)EE);
	BEGIN
	RPTR(EXPR$)E;
	INTEGER TYP,VAL;
	IF EE=NULL!RECORD THEN
	    BEGIN VAL←0; TYP←#PR END
	    ELSE BEGIN VAL←#MINUS1; TYP←EXPR$:TYPE[EE]; END;
	E←EXPR$2(XRETURN,VAL);
	RETURN($APPEND(EE,E,TYP));
	END;

INTERNAL RPTR(EXPR$)PROCEDURE $PRCDCLPCODE(RPTR(SYMBOL)SYM; RPTR(EXPR$)PBODY);
	BEGIN
	INTEGER NARGS,ENV;
	RPTR(EXPR$) ARRAY PTR[1:5];
	RPTR(EXPR$)PPTR;
	RPTR(PROC)P;
	INTEGER I,IPC;
	INTEGER OBTYPE;
	OBTYPE←SYMBOL:TYPE[SYM];
	NARGS←PROC:NARGS[P←SYMBOL:OBJECT[SYM]];
	ENV←NARGS;		! include the local variables too ;
	IPC← - 1 ;		! dummy to get PPCODE to print out ;
	PTR[1]←EXPR$2(XGTBLK);
	PTR[2]←PBODY;
	PTR[3]←EXPR$2(XRETURN);
	IF SYMBOL:TYPE[CURPROC]≠#PR THEN EXPR$:BODY[PTR[3]][2]←#MINUS1;
	EXPR$:BODY[PTR[1]][2]←EXPR$OFF(PTR,2,3)-1;
	PTR[4]←EXPR$1(5);
	FOR I←XMVAR,#PRCTYP,1,NARGS,IPC,ENV+30 DO IPUSH(I);
	FOR I←1 STEP 1 UNTIL NARGS DO IPUSH(PROC:ARGACCS[P][I]
			+OBTYPES[PROC:ARGTYPE[P][I]]);
	IPUSH(0);	! indicate end of mvar pcode;
	PTR[5]←βEXPR$(OBTYPE);	! this is the procedure header ;
	PPTR←$AAPPEND(PTR);
	RETURN(PPTR);
	END;

RPTR(EXPR$) PROCEDURE ARRDCLPCODE0(RPTR(EXPR$)ARRAY BOUNDS;
	INTEGER OBTYPE,ADIM,OFFSET);
	BEGIN
	RPTR(EXPR$) ARRAY $BOUNDS[1:4*ADIM+1];
	RPTR(EXPR$) PTR; RPTR(SYMBOL)S; RPTR(ARRAYREC)A;
	INTEGER I,I1,I2,J;
	J←$TSCOFF-1; I2←0;
	FOR I←1 STEP 1 UNTIL 2*ADIM DO
		BEGIN
		$BOUNDS[I2←I2+1]←BOUNDS[I];
		FOR I1←XCHNGE,J+I DO IPUSH(I1);
		$BOUNDS[I2←I2+1]←βEXPR$;
		END;
	FOR I1←XMVAR,#ARRTYP + OBTYPES[OBTYPE],ADIM DO IPUSH(I1);
	FOR I1←2 STEP 2 UNTIL ADIM*2 DO BEGIN IPUSH(J+I1); IPUSH(J+I1-1); END;
	IPUSH(0);
	$BOUNDS[I2←I2+1]←βEXPR$;
	PTR←$AAPPEND($BOUNDS,OBTYPE);
	RETURN(PTR);
	END;

INTERNAL RPTR(EXPR$) PROCEDURE $ARRDCLPCODE(RPTR(EXPR$)ARRAY BOUNDS;
	INTEGER OBTYPE,ADIM,OFFSET);
	BEGIN RPTR(EXPR$)ARRAY A[1:2];
	A[1]←ARRDCLPCODE0(BOUNDS,OBTYPE,ADIM,OFFSET);
	A[2]←EXPR$2(XARRINI,OFFSET);
	RETURN($AAPPEND(A));
	END;
! load,dump pcodes;

INTERNAL RPTR(EXPR$) PROCEDURE EXPR$F(RPTR(SYMBOL)S;INTEGER OFFSET);
IF SYMBOL:ACCESS[S]=#ARRAY_ELEMENT 
   THEN BEGIN
	STRING S1; INTEGER I;
	INTEGER ARRAY INDEX[1:5]; INTEGER IX;
	S1←SYMBOL:PNAME[S];
	DO I←LOP(S1) UNTIL I="[";
	IX←0;
	DO INDEX[IX←IX+1]←INTSCAN(S1,I) UNTIL I="]";
	FOR I←IX STEP -1 UNTIL 1 DO BEGIN IPUSH(XPUSHINTI); IPUSH(INDEX[I]); END;
	FOR I←XPUSHOFFSET,OFFSET DO IPUSH(I);
	RETURN(βEXPR$(SYMBOL:TYPE[S]));
	END 
   ELSE IF SYMBOL:INDEX[S]>0 
	   THEN RETURN($APPEND(EXPR$2(XAPUSHOFFSET,SYMBOL:INDEX[S]),
			EXPR$1(SYMBOL:OFFSET[S]),SYMBOL:TYPE[S]))
	   ELSE IF SYMBOL:OFFSET[S]<'1000
           THEN RETURN($APPEND(EXPR$1(XPUSHINTI),EXPR$1(SYMBOL:OFFSET[S]),
			SYMBOL:TYPE[S]))
	   ELSE RETURN(EXPR$1(XNOOP));		! may not be used;


INTERNAL RPTR(EXPR$) PROCEDURE L$PCODE(RPTR(SYMBOL)PTR,DAD;RPTR(EXPR$)EXP;
					INTEGER TYPE,HOW,OFFSET(0));
	BEGIN
	RANY OBJECT; RPTR (EXPR$) ARRAY BUF[1:5];
	PRELOAD_WITH XPUSHSCI,XMKVT,XMKRT,XMKTR,XMKTR,XNOOP;
	OWN INTEGER ARRAY LCODE[#SC:#EV];

	OBJECT←SYMBOL:OBJECT[PTR];
	IF TYPE=#EV THEN RETURN(NULL_RECORD)
		ELSE BUF[1]←EXPR$1(LCODE[TYPE]);
	BUF[2]←EXP;
	IF TYPE=#FR AND HOW≠#INDLK
	   THEN BEGIN
		BUF[3]←EXPR$F(DAD,OFFSET);
		BUF[4]←EXPR$F(PTR,OFFSET);
		BUF[5]←EXPR$2(XPAFFIX, IF HOW≠#RGDLK THEN #NONRGD ELSE 0);
		END
	   ELSE BEGIN
		BUF[3]←EXPR$F(PTR,OFFSET);
		BUF[4]←EXPR$1(XCHNGS);
		END;
	RETURN($AAPPEND(BUF,TYPE));
	END;

INTERNAL RPTR(EXPR$) PROCEDURE L$ARRDCLPCODE(RPTR(SYMBOL)SYMPTR;INTEGER TYPE);
	BEGIN
	INTEGER I,ADIM;RPTR(ARRAYREC)OBJECT;
	ADIM←ARRAYREC:#DIM[OBJECT←SYMBOL:OBJECT[SYMPTR]];
		BEGIN
		RPTR(EXPR$) ARRAY BOUNDS[1:10];
		FOR I←1 STEP 1 UNTIL ADIM DO
			BEGIN
			BOUNDS[I*2-1]←EXPR$2(XPUSHINTI,ARRAYREC:LB[OBJECT][I]);
			BOUNDS[I*2]←EXPR$2(XPUSHINTI,ARRAYREC:UB[OBJECT][I]);
			END;
		RETURN(ARRDCLPCODE0(BOUNDS,TYPE,ADIM,SYMBOL:OFFSET[SYMPTR]));
		END;
	END;

INTERNAL RPTR(EXPR$) PROCEDURE L$ARRPCODE(RPTR(SYMBOL)PTR;INTEGER TYPE;RPTR(EXPR$)EXP);
	BEGIN
	RPTR(EXPR$)ARRAY EXPR[1:3];RPTR(EXPR$)TEMP;
	EXPR[1]←L$ARRDCLPCODE(PTR,TYPE);
	EXPR[2]←EXPR$3(XARRLD,SYMBOL:OFFSET[PTR],TYPE);
	EXPR[3]←EXP;
	RETURN($AAPPEND(EXPR,TYPE));
	END;

END "PCODE";